#!/usr/bin/perl -w
# This file is a bit of a hack, but I wanted to get this task out of the 
# way quickly.  Were I to spend more time here, I would likely develop
# a scheme where I passed in a structure of expected HTML tags
# and text into a function along with an HTML documents $root, and then
# had it automatically pull out the info embeded in the structure.  Instead,
# I have a functions that verify each document section, and other functions
# that pull out the desired data if the verification functions return true.
# Likely more lines of code, but much simpler TO code.


use HTML::TreeBuilder;

require "chunker.pl";

############# THE MAIN PROGRAM #####################
### takes an open file reference and processes its contents, returning its 
### results as a formatted string (generally to be written directly to a
### text file)
sub processHTMLDocument
{
	## HTML document file path
	my $filename = shift;
	## file handle for output
	my $OUTF = shift;
	
	
	my $root = HTML::TreeBuilder->new();
	$root->parse_file($filename);
	if(!$root)
	{
		return undef;
	}
	$root->elementify();
	my @elements = $root->content_list();
	
	## used later for recursing
	#my($table, $tr, $td);
	
	my $elm = getElement("BODY", @elements);
	if(!$elm)
	{
		print "!!!	Body tag not found!\n";
		goto UNDEF;  ## <- WTF is this you might ask?  "Lazy" is the answer.
	}
	
	@elements = $elm->content_list();
	
	## find the first HR tag
	my $i = getElementIndex("HR", 0, @elements);
	if($i < 0)
	{
		print "!!!  Document contains no HR tag\n";
		goto UNDEF;
	}
	
	## test to see whether this patent has been withdrawn/etc
	if(isNotFullText($i, @elements))
	{
		print "!!!  Patent is not fulltext!\n";
		goto UNDEF;
	}
	
	## So far so good, now start validating sections of the patent and 
	## extracting text sections for output. 
	my $s;  # holds return values
	
	## get basic info
	if(isBasicInfo($i, @elements))
	{
		$s = getBasicInfo($i, @elements);
		print $OUTF $s;
		
		## skip to next 'section'
		$i = getElementIndex("HR", $i+1, @elements);
		if($i<0)
		{
			print "!!!  No HR's after basic info!\n";
			goto UNDEF;
		}
	}
	else
	{
		print "!!!  Basic info not found!\n";
		goto UNDEF;
	}
	
	## get the abstract
	if(isAbstract($i, @elements))
	{
		$s = getAbstract($i, @elements);
		print $OUTF $s;
		
		## skip to next section
		$i = getElementIndex("HR", $i+1, @elements);
		if($i<0)
		{
			print "!!!  No HR's after Abstract!\n";
			goto UNDEF;
		}
	}
	else
	{
		print "!!!  Abstract info not found!\n";
		goto UNDEF;
	}
	
	## find inventors for skipping
	## TODO:  This section is pretty essential, so if we don't find it
	##			 it's probably our problem.  Thus, we may later want to 
	##			 make not finding it an error instead of just a warning
	if(isInventors($i, @elements))
	{
		## TODO:  Care about this info later?
		
		## we found it!  Now skip it!
		$i = getElementIndex("HR", $i+1, @elements);
		if($i<0)
		{
			print "!!!  No HR's after Inventors!\n";
			goto UNDEF;
		}
	}
	else
	{
		print "!!!	Inventors not found!\n";
		goto UNDEF;
	}
	
	## Related U.S. Patent Documents:
	##		This section is often not present
	if(isRelatedPatDocs($i, @elements))
	{
		## promptly skip
		$i = getElementIndex("HR", $i+1, @elements);
		$i = getElementIndex("HR", $i+1, @elements) if $i>0;
		if($i<0)
		{
			print "!!!  No HR's after Related U.S. Patent Documents!\n";
			goto UNDEF;	
		}
	}
	else
	{
		## this is totally ok, do nothing
	}
	
	## Foreign Application Priority Data
	##		If this is present things get a little more messy
	##		the Current US Class section below screws up overall
	##		formatting by wrapping everything below it in a <P>.
	##		Not too big a deal, but if this section is present,
	##		CUSC has no leading HR tag
	if(isFAPD($i, @elements))
	{
		# promptly skip
		$i = getElementIndex("HR", $i+1, @elements);
		$i = getElementIndex("P", $i+1, @elements) if $i>0; # remember screwy <P>
		if($i<0)
		{
			print "!!!	Could not find <P> for Current U.S Class after FAPD\n";
			goto UNDEF;
		}
		
	}
	else
	{
		## this is totally ok, do nothing
	}
	
	## I account for this HR in isCUSC but it makes things 
	## easier here if skipped
	$i++ if(isTag($elements[$i], "HR")); 
	if(isCUSC($i, @elements))
	{
		## recurse into random <P> tag
		@elements = ($elements[$i])->content_list();
		
		$i = getElementIndex("HR", 0, @elements); ## note the 0 index
		if($i<0)
		{
			print "!!!  No HR after Current U.S. Class\n";
			goto UNDEF;	
		}
	}
	else
	{
		print "!!!	Current U.S. Class not found!\n";
		goto UNDEF;
	}
	
	## references cited - a required section that we actually take data from
	if(isRefsCited($i, @elements))
	{
		$s = getUSPatentDocs($i, @elements);
		if($s)
		{
			print $OUTF $s;
		}
		else
		{
			print "\nWARNING:  Patent contains no US Patent Document References\n";
		}
		
		$i = getElementIndex("HR", $i+1, @elements);
		$i = getElementIndex("HR", $i+1, @elements) if $i>0;
		if($i<0)
		{
			print "!!!  No HR after References Cited\n";
			goto UNDEF;	
		}
		
	}
	else
	{
		print "!!!	References Cited not found!\n";
		goto UNDEF;
	}
	
	if(isGovInterests($i, @elements))
	{
		$i = getElementIndex("HR", $i+1, @elements);
		$i = getElementIndex("HR", $i+1, @elements) if $i>0;
		if($i<0)
		{
			print "!!!  No HR after Government Interests\n";
			goto UNDEF;
		}
	}
	
	if(isParentCaseText($i, @elements))
	{
		$i = getElementIndex("HR", $i+1, @elements);
		$i = getElementIndex("HR", $i+1, @elements) if $i>0;
		if($i<0)
		{
			print "!!!  No HR after Parent Case Text\n";
			goto UNDEF;	
		}
	}
	
	if(isClaims($i, @elements))
	{
		getClaims($i, $OUTF, @elements);
		
		$i = getElementIndex("HR", $i+1, @elements);
		$i = getElementIndex("HR", $i+1, @elements) if $i>0;
		if($i<0)
		{
			print "!!!  No HR after Claims\n";
			goto UNDEF;	
		}
	}
	else
	{
		print "!!!	Claims not found!\n";
		goto UNDEF;
	}
	
	if(isDescription($i, @elements))
	{
		getDescription($i, $OUTF, @elements);
		
		## all done!
	}
	else
	{
		print "!!!	Description not found!\n";
		goto UNDEF;
	}
	return 1;
	
UNDEF:
	## TODO:	We may want to delete any converted patents
	## 		that fail midway for some reason
	
	$root->delete; # clear memory
	return 0;
}



############# HELPER FUNCTIONS #####################

sub getElement
{
	my $tag = shift;
	my @elements = @_;
	
	## find the BODY tag
	foreach (@elements)
	{
		if(isTag($_, $tag))
		{
			return $_;
		} 
	}
	
	return undef;
}

sub getElementIndex
{
	my $tag = shift;
	my $offset = shift;
	
	my @elements = @_;
	#print "number of elements: $#elements, offset: $offset\n";
	for(my $i = $offset; $i <= $#elements; $i++)
	{
		#print "i: $i, tag: " . $elements[$i]->tag() . "\n";
		if(isTag($elements[$i], $tag))
		{
			return $i;
		}
	}
	
	return -1;
}

# checks whether $_ is an HTML::Element
sub isElement
{
	return ref(shift) eq 'HTML::Element';
}

# checks whether $_[0] is an HTML::Element and a tag of type $_[1]
sub isTag
{
	my $elm = shift;
	my $tag = shift;
	
	return 0 if !isElement($elm);
	return 0 if uc($elm->tag()) ne uc($tag);
	return 1;
}

# checks whether $_[0] is a string and that its first n characters
# match that of $_[1] where n is the length of $_[1]
sub hasSubstr
{
	my $test = shift;
	my $str = shift;
	
	my $sub = substr($test, 0, length($str));
	
	#print "str: '$str', sub: '$sub'\n";
	
	return $sub eq $str;
}

sub firstChild
{
	my $elm = shift;
	
	## ensure that our tag is an element
	if(!isElement($elm))
	{
		print "!!!   Tried to get the first child of a non-element\n";
		return undef;
	}
	
	return ($elm->content_list())[0];
}

sub child
{
	my $elm = shift;
	my $index = shift;
	if(!isElement($elm))
	{
		print "!!!   Tried to get the first child of a non-element\n";
		return undef;
	}
	return ($elm->content_list())[$index];
}

############# TESTER FUNCTIONS #####################
## Behold:  My lazy method of document verification.  Cringe, you may, and
## for that I appologize.


## Tests whether the full text of the patent is not available (also covers withdrawn patents)
#hr
#center
#		font
#				b
#					'Full text is not available for this patent. Click on "Images" button above to view full patent.'
sub isNotFullText
{
	## index of test
	my $index = shift;
	##  content list to walk through
	my @clist = @_;
	my $next;
	
	#$next = $clist[$index];
	#return 0 if !isTag($next, "HR");
	
	$next = $clist[++$index];
	return 0 if !isTag($next, "CENTER");
	
	$next = firstChild($next);
	return 0 if !isTag($next, "FONT");
	
	$next = firstChild($next);
	return 0 if !isTag($next, "B");
	
	$next = firstChild($next);
	return 0 if !hasSubstr($next, "Full text is not available");
	
	return 1;
}

sub isBasicInfo
{
	my $index = shift;
	my @clist = @_;
	my($next);
	
	#$next = $clist[$index];
	#return 0 if !isTag($next, "HR");
	
	$next = $clist[++$index];
	return 0 if !isTag($next, "TABLE");
	
	$next = firstChild($next);
	return 0 if !isTag($next, "TR");
	
	$next = firstChild($next);
	return 0 if !isTag($next, "TD");
	
	return 0 if !hasSubstr($next->as_text, "United States Patent");
	
	return 1;
}

sub isAbstract
{
	my $index = shift;
	my @clist = @_;
	
	#my $next = $clist[$index];
	#return 0 if !isTag($next, "HR");
	
	#$next = $clist[++$index];
	#return 0 if !isTag($next, "FONT");
	
	#$next = $clist[++$index];
	#return 0 if !isTag($next, "BR");
	
	#$next = $clist[++$index];
	#return 0 if !isTag($next, "BR");
	
	$next = $clist[$index+4];  #[++$index];
	return 0 if !isTag($next, "CENTER");
	
	return 0 if !hasSubstr($next->as_text, "Abstract");
	
	return 1;
}

sub isInventors
{
	my $index = shift;
	my @clist = @_;
	my $next;
	
	#$next = $clist[$index];
	#return 0 if !isTag($next, "HR");
	
	$next = $clist[++$index];
	return 0 if !isTag($next, "TABLE");
	
	$next = firstChild($next);
	return 0 if !isTag($next, "TR");
	
	$next = firstChild($next);
	return 0 if !isTag($next, "TD");
	return 0 if !hasSubstr($next->as_text, "Inventors:");
	
	return 1;
}

sub isRelatedPatDocs
{
	my $index = shift;
	my @clist = @_;
	my $next;
	
	#$next = $clist[$index];
	#return 0 if !isTag($next, "HR");
	
	$next = $clist[++$index];
	return 0 if !isTag($next, "CENTER");
	return 0 if !hasSubstr($next->as_text, "Related U.S. Patent Documents");
	
	return 1;
}

sub isFAPD
{
	my $index = shift;
	my @clist = @_;
	my $next;
	
	#$next = $clist[$index];
	#return 0 if !isTag($next, "HR");
	
	$next = $clist[++$index];
	return 0 if !isTag($next, "CENTER");
	return 0 if !hasSubstr($next->as_text, "Foreign Application Priority Data");
	
	return 1;
}


### is Current U.S. Class
### NOTE:  When extracting info for here, a recurse into this
###   elements <P> tag will be required for future sections.
### (Bloody bad HTML output from the USPTO)
sub isCUSC
{
	my $index = shift;
	my @clist = @_;
	my $next = $clist[$index];
	
	### this little bugger accounts for when Current U.S. Class
	### is part of FAPD
	$next = $clist[++$index] if(isTag($next, "HR"));
	return 0 if !isTag($next, "P");
	
	$next = firstChild($next);
	return 0 if !isTag($next, "TABLE");
	
	$next = firstChild($next);
	return 0 if !isTag($next, "TR");
	
	$next = firstChild($next);
	return 0 if !isTag($next, "TD");
	
	return 0 if !hasSubstr($next->as_text, "Current U.S. Class:");
	
	return 1;
}

sub isRefsCited
{
	my $index = shift;
	my @clist = @_;
	my $next;
	
	$next = $clist[$index+1]; # index should be at HR tag
	return 0 if !isTag($next, "CENTER");
	return 0 if !hasSubstr($next->as_text, "References Cited");
	
	return 1;
}

sub isGovInterests
{
	my $index = shift;
	my @clist = @_;
	my $next;
	
	$next = $clist[$index+1];  # index should be at HR tag
	return 0 if !isTag($next, "CENTER");
	return 0 if !hasSubstr($next->as_text, "Government Interests");
	
	return 1;
}

sub isParentCaseText
{
	my $index = shift;
	my @clist = @_;
	my $next;
	
	$next = $clist[$index+1];  # index should be at HR tag
	return 0 if !isTag($next, "CENTER");
	return 0 if !hasSubstr($next->as_text, "Parent Case Text");
	
	return 1;
}

sub isClaims
{
	my $index = shift;
	my @clist = @_;
	my $next;
	
	$next = $clist[$index];
	return 0 if !isTag($next, "HR");
	
	$next = $clist[++$index];
	return 0 if !isTag($next, "CENTER");
	return 0 if !hasSubstr($next->as_text, "Claims");
	
	return 1;
}

sub isDescription
{
	my $index = shift;
	my @clist = @_;
	my $next;
	
	$next = $clist[$index];
	return 0 if !isTag($next, "HR");
	
	$next = $clist[++$index];
	return 0 if !isTag($next, "CENTER");
	return 0 if !hasSubstr($next->as_text(), " Description");
	
	return 1;
}

############# INFORMATION EXTRACTION FUNCTIONS #####################

## Returns a string formatted as so (all lines flush left):
##	number: #,###,###
##	author: Authorname, et al
##	date: December 31, 2002
sub getBasicInfo
{
	my $index = shift;
	my @clist = @_;
	
	my($tr, $td);
	my($pnum, $author, $date);
	
	isTag($clist[$index++], "HR") or die "getBasicInfo -> HR";
	isTag($clist[$index], "TABLE") or die "getBasicInfo -> TABLE";
	$tr = firstChild($clist[$index]);
	isTag($tr, "TR") or die "getBasicInfo -> TR 0";
	
	## Patent Number
	$td = child($tr, 1);
	isTag($td, "TD") or die "getBasicInfo -> TD 0";
	$pnum = $td->as_text();
	
	$tr = child($clist[$index], 1);
	isTag($tr, "TR") or die "getBasicInfo -> TR 1";
	
	## Author
	$td = child($tr, 0);
	isTag($td, "TD") or die "getBasicInfo -> TD 1";
	$author = $td->as_text();
	## Date
	$td = child($tr, 1);
	isTag($td, "TD") or die "getBasicInfo -> TD 2";
	$date = $td->as_text();
	
	
	return "number: $pnum\nauthor: $author\ndate: $date\n";
}

## extracts the [title] and [abstract] from the text and outputs both
## to $outf chunked
sub getAbstract
{	
	## @foo = chunkText($someText);

	my $index = shift;
	my @clist = @_;
	my $next;
	my($title, $abstract, @tmp);
	
	$next = $clist[$index];
	isTag($next, "HR") or die "getAbstract -> HR";
	
	$next = $clist[++$index];
	isTag($next, "FONT") or die "getAbstract -> FONT";
	@tmp = chunkText($next->as_text()) or die "getAbstract -> title";
	$title = $tmp[0] ;
	
	## only test one of the BR's for speed (lazy) sake
	$index+=2;
	$next = $clist[$index];
	isTag($next, "BR") or die "getAbstract -> BR";
	
	$next = $clist[++$index];
	isTag($next, "CENTER") or die "getAbstract -> CENTER";
	hasSubstr($next->as_text, "Abstract") or die "getAbstract -> \"Abstract\"";
	
	$next = $clist[++$index];
	isTag($next, "P") or die "getAbstract -> P";
	@tmp = chunkText($next->as_text()) or die "getAbstract -> Abstract Text";
	$abstract = join("\n", @tmp);
	
	return "title: $title\nabstract:\n$abstract\n/abstract\n";	
}

sub getUSPatentDocs
{
	my $index = shift;
	my @clist = @_;
	my $next;
	my(@children, $td, $pnum);
	my $returned = "\n";
	
	$next = $clist[$index];
	isTag($next, "HR") or die "getUSPatentDocs -> HR";
	
	
	## ensure that this patents references cited includes a U.S. Patent Documents
	## section, otherwise we aren't interested
	$next = $clist[$index+3];
	return undef if !isTag($next, "CENTER");
	return undef if !hasSubstr($next->as_text, "U.S. Patent Documents");
	
	
	$index += 4; # center, hr, center, >>table<<
	$next = $clist[$index];
	isTag($next, "TABLE") or die "getUSPatentDocs -> TABLE";
	
	@children = $next->content_list();
	
	## skip the first and last TR as they are duds
	for(my $i = 1; $i < $#children; $i++)
	{
		$td = firstChild($children[$i]);
		$pnum = $td->as_text();
		$returned .= "related-patent: $pnum\n";
	}
	
	return $returned;
}

## this get routine, like getDescription is special in that it takes
## the output file handle as one of its arguments so that data
## can be written directly
sub getClaims
{
	my $index = shift;
	my $OUTF = shift; ## output file handle
	my @clist = @_;
	my($text, @chunked);
	
	## hr, center, hr
	$index += 3;
	
	print $OUTF "claims:\n";
	
	while(!isTag($clist[$index], "HR"))
	{
		while(isTag($clist[$index], "BR")) { $index++; }
		while(!isElement($clist[$index]))
		{
			## extract the text
			$text = $clist[$index];
			
			## ensure that this section isn't a bloody 'TABLE-US-'
			## section as the POST doesn't particularily like those
			#if(substr($text, 0, 9) ne "TABLE-US-")
			if(!($text =~ /^\s*TABLE-US-/))
			{
				## chunk it
				@chunked = chunkText($text) or die "getClaims -> chunkText";
			
				print $OUTF join("\n", @chunked);
			}
			else
			{
				print "\n!!!  Skipped a TABLE section in CLAIMS\n";
			}
			
			$index++;
		}
	}
	
	print $OUTF "\n/claims\n";
}
## identical to claims except for "* * * * *" check
sub getDescription
{
	my $index = shift;
	my $OUTF = shift; ## output file handle
	my @clist = @_;
	my($text, @chunked);
	
	## hr, center, hr
	$index += 3;
	
	print $OUTF "description:\n";
	
	while(!isTag($clist[$index], "HR") and !isTag($clist[$index], "CENTER"))
	{
		while(isTag($clist[$index], "BR")) { $index++; }
		while(!isElement($clist[$index]))
		{
			## extract the text
			$text = $clist[$index];
			
			## ensure that this section isn't a bloody 'TABLE-US-'
			## section as the POST doesn't particularily like those
			##if(substr($text, 0, 9) =~ /\w*TABLE-US-/)
			if(!($text =~ /^\s*TABLE-US-/))
			{
			
				## chunk it
				@chunked = chunkText($text);
				if(!@chunked)
				{
					 print "WARNING:  (getDescription -> chunkText) Chunked returned an empty list!\n";
				}
				else
				{
					print $OUTF join("\n", @chunked);
				}
			}
			else
			{
				print "\n!!!  Skipped a TABLE section in DESCRIPTION\n";
			}
			
			$index++;
		}
	}
	
	print $OUTF "\n/description\n";
}

######################### TESTS ####################################

sub testPHTMLD
{
	my $filename = "patent.html";
	my $outfile = "output.txt";
	if(-e $outfile)
	{
		unlink($outfile);
	}
	open($F, ">$outfile") || die "Couldn't open output file\n";
	processHTMLDocument($filename, $F);
	close $F;
}

#testPHTMLD();

#return 1;



